home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM BV3 / BMUG PD-ROM Version BV3 (CDRM1097900).iso / Programming / Programming Languages / Pocket Forth 6 / Examples / Apple Events / AppleEvents < prev   
Encoding:
Text File  |  1992-05-07  |  2.8 KB  |  61 lines  |  [TEXT/McSk]
  1. ( Apple Events for Pocket Forth 0.6 and HyperCard 2.1 )
  2. forget task decimal  0 28 +md ! 
  3.  
  4. 2variable DOSC.DATA 4 allot ( aedesc holder )
  5.  
  6. : AEDisposeDesc  ( r: room d.addr -- error )
  7.   ( move.w #$0204,d0 _Pack8 )  ,$ 303C ,$ 0204 ,$ A816 ; macro
  8.  
  9. : -DESC ( -- ) ( dispose of the descriptor )
  10.     0 >r  dosc.data a>r                ( push room and descriptor )
  11.     AEDisposeDesc  r> drop ;              ( recklessly drop error )
  12.  
  13. ( This word is installed into the idle handler by the apple event.)
  14. : DOSCIDLE ( -- ) ( interpret text whose handle is at above var.  )
  15.     [ ' null literal ]  20 +md !     ( reset idle routine to null )
  16.     
  17.   ( movea.l dd+4[bp],a0 )  ,$ 206B [ dosc.data 4 + , ]   ( handle )
  18.   ( _GetHandleSize    )  ,$ A025            ( bytes to move in d0 )
  19.   ( movea.l [a0],a0   )  ,$ 2050           ( source address in a0 )
  20.   ( movea.l is,a1     )  ,$ 224C      ( destination [is=a4] in a1 )
  21.   ( _BlockMove        )  ,$ A02E      ( move data to input stream )
  22.     -desc                             ( dispose of the descriptor )
  23.     13 tib 79 + c!     ( follow input stream with a cr [ascii=13] )
  24.     interpret  [       ( jump to interpreter; see below )
  25.  
  26.     ( Follow a call to interpret with [ instead of ; since it will)
  27.     ( never return. The interpreter will fix up the return stack  )
  28.     ( the text is interpreted. Until then, it's not a problem.    )
  29.  
  30. : AEGetParamDesc  ( r: room d.evt d.key d.type d.addr -- error )
  31.   ( move.w #$0812,d0 _Pack8 )  ,$ 303C ,$ 0812 ,$ A816 ; macro
  32.  
  33. : ?DESC ( d.key d.type -- 8.AEDesc 1 or 0 )   ( get AEDesc handle )
  34.     0 >r                                  ( room for error        )
  35.     202 +md 2@ 2>r                        ( the AppleEvent        )
  36.     2swap 2>r  2>r                        ( keyword and type      )
  37.     here a>r                              ( recieving address     )
  38.     AEGetParamDesc
  39.     r> 0= IF                           ( if there is no error     )
  40.       here 4 + 2@  here 2@  -1         ( get data & leave true    )
  41.     ELSE  0 THEN ;                     ( or else leave false      )
  42.  
  43. ( The apple event handler for the 'dosc' or "do script" event from)
  44. ( HyperCard 2.1.  Use "send [text] to program "Pocket Forth".     )
  45. ,s dosc ,s misc  ae:  ( mon )
  46.     ,s ---- ,s TEXT ?desc IF           ( if there is no error     )
  47.       dosc.data 2!  dosc.data 4 + 2!   ( store handle to the data )
  48.       [ ' doscIdle literal ] 20 +md !  ( set idle routine to above)
  49.     THEN
  50.   ;ae
  51.  
  52. -1 28 +md ! ( restore echo )
  53. page beep beep beep
  54. ( Press any key to install a 'Do Script' Apple Event into )
  55. ( this copy of Pocket Forth.  Do this ONLY if this is a   )
  56. ( COPY of Pocket Forth.  If you need to bail out and make )
  57. ( a copy, close this window, or choose Quit from the menu.)
  58. key drop
  59. : task ; ( protect this from "forget task" )
  60. save bye  ( Re-open me! )
  61.